(* ast.sml --- 
 * 
 * Filename: ast.sml
 * Description:  Abstract Syntax Tree of our C language
 *)

(* Code: *)

structure Ast = struct 

type pos = int
type id  = string * pos 

datatype UniOp = 
	 (* -x *)
	 Neg of pos
       (* if(!x) *)
       | Not of pos

datatype BinOp =
	 (* + - * / *)
	 Add of pos
       | Sub of pos
       | Mul of pos
       | Div of pos

datatype LogicOp =
	 (* && || *)
	 And of pos
       | Or of pos

datatype RelOp=
	 (* == != > >= < <= *)
	 Eq of pos
       | Ne of pos
       | Gt of pos
       | Ge of pos
       | Lt of pos
       | Le of pos

(* types *)
datatype Type 
  (* int  *)
  = Int of pos
  (* char *)
  | Char of pos
  (* void *)
  | Void of pos
  (* struct id *)
  | StructType of id * pos
  (* type* *)
  | Pointer of Type * pos
  (* type[num] *)
  | Array of int * Type * pos


(* expressions *)
datatype Exp
  (* -e !e *)
  = UniOpExp of Exp * UniOp * pos
  (* e+e e-e ... *)
  | BinOpExp of Exp * BinOp * Exp * pos
  (* e&&e ... *)
  | LogicOpExp of Exp * LogicOp * Exp * pos
  (* e>e ... *)
  | RelOpExp of Exp * RelOp * Exp * pos
  (* call a function: id(parameter,parameter...) *)
  | FunCall of id * (Exp list) * pos
  (* parened exp e.g. (x+1) *)
  | Paren of Exp * pos
  (* L-value *)
  | LvalExp of Lval * pos
and Lval 
  (* id *)
  = Ident of id * pos
  (* id.field *)
  | Dot of Lval * string * pos
  (* *id *)
  | Star of Lval * pos
  (* id->field *)
  | Pto of Lval * string * pos
  (* id[num] *)
  | Index of Lval * Exp * pos

(* declare a variable *)
(* int a; *)
type VarDecl= Type * id * pos 

(* Statements *)
datatype Stm
  (* if *)
  = If of Exp * BlockType * BlockType * pos
  (* while *)
  | While of Exp * BlockType * pos 
  (* return exp *)
  | Return of Exp * pos 
  (* return; *)
  | ReturnNull of pos
  (* for(stm;exp;stm) block *)
  | For of Stm * Exp * Stm * BlockType * pos 
  (* exp e.g.  x+1; func(x); *)
  | ExpStm of Exp * pos
  (* lval = exp  *)
  | Assign of Lval * Exp * pos
  (* block e.g. {int x;return x;} *)
  | BlockStm of BlockType * pos
and BlockType 
  = Block of (VarDecl list) * (Stm list) * pos 

(* only Type of the function(without block) *)
type FunctionProto = Type * id * VarDecl list * pos 

(* function *)
(* int main(int x) {return x;} *)
(* Type id  VarDecl list Block *)
type Function = FunctionProto * BlockType * pos



(* struct *)
(* struct test{int x;int y;} *)
(*        id  VarDecl list   *)
type Struct = id * (VarDecl list) * pos 

(* A program contains FunctionProtos, Structs and Functions *)

(* !!!ATTENTION!!! *)
(* Your Yacc File Should return a value with P *)
datatype Program = 
	 P of FunctionProto list * Struct list * Function list 
       (* useless, only for empty yacc file *)
       | Skip

(* sepBy ["a","b","c"] "," = "a,b,c" *)
fun sepBy (slist:string list)(token:string) = 
    case slist of 
	[] => ""
      | s::rs => s ^ (List.foldr (fn (a,b)=> token ^ a ^ b) "" rs)


(* Print Ast *)
fun Program2Str (P(fps,structs,funcs):Program):string =
    let val fps_str    = sepBy (List.map FunctionProto2Str fps) "\n"
	val structs_str= sepBy (List.map Struct2Str structs) "\n"
	val funcs_str  = sepBy (List.map Function2Str funcs) "\n"
    in
	fps_str ^ "\n" ^ structs_str ^ "\n" ^ funcs_str ^ "\n"
    end
  | Program2Str Skip = "Finish Your Yacc File! Modify the Action of rule program! "

and FunctionProto2Str ((t,id,vlist,pos):FunctionProto):string =
    let val t_str     =Type2Str t
	val id_str    =Id2Str id
	val vlist_str =sepBy (List.map Vdec2Str vlist) ","
    in 
	t_str ^ " " ^ id_str ^ "(" ^ vlist_str ^ ")"
    end

and Type2Str (t:Type):string =
    case t of 
	Int _ => "int"
      | Char _ => "char"
      | Void _ => "void"
      | StructType(id,_) => "struct " ^ (Id2Str id)
      | Pointer(t',_) => (Type2Str t')^"*"
      | Array(i,t',_) => (Type2Str t')

and Id2Str ((str,pos):id):string =
    str 

and Vdec2Str ((t,id,pos):VarDecl):string =
    case t of 
	Array(i,t',_)=>
	Type2Str t ^ " " ^ Id2Str id ^"["^Int.toString i^"];"
      | _ =>
	Type2Str t ^ " " ^ Id2Str id ^ ";"

and Struct2Str ((id,vlist,pos):Struct):string =
    let val id_str=Id2Str id 
	val vlist_str=sepBy (List.map Vdec2Str vlist) "\n"
    in 
	"struct " ^ id_str ^ "{" ^ vlist_str ^ "}"
    end

and Function2Str((proto,block,pos):Function):string =
    let val proto_str=FunctionProto2Str proto 
	val block_str=Block2Str block 
    in 
	proto_str ^ block_str
    end	

and Block2Str(Block (vlist,slist,pos):BlockType):string = 
    let val vlist_str=sepBy (List.map Vdec2Str vlist) "\n"
	val slist_str=sepBy (List.map Stm2Str slist) "\n"
    in 
	"{" ^ vlist_str ^ slist_str ^ "}"
    end	

and Stm2Str (stm:Stm):string =
    case stm of 
	If(exp,block1,block2,_)=>
	(case block2  of 
	     Block([],[],_) =>
	    "if("^Exp2Str exp^")" ^ Block2Str block1 
	   | _ =>
	    "if("^Exp2Str exp^")\n" ^ Block2Str block1 ^ "\nelse\n" ^ Block2Str block2)
      | While(exp,block,_)=>
	"while("^Exp2Str exp^")\n" ^ Block2Str block 
      | Return(exp,_) =>
	"return "^Exp2Str exp^";"
      | ReturnNull _ =>
	"return;"
      | For(stm1,exp,stm2,block,_)=>
	"for("^Stm2Str stm1^";"^Exp2Str exp^";"^Stm2Str stm2^")\n"^Block2Str block
      | ExpStm(exp,_) =>
	Exp2Str exp^";"
      | Assign(lval,exp,_)=>
	Lval2Str lval ^ "=" ^ Exp2Str exp ^";"
      | BlockStm(block,_)=>
	Block2Str block

and Exp2Str (exp:Exp):string =
    case exp of 
	UniOpExp(exp,oper,_)=>
	UniOp2Str oper ^ Exp2Str exp 
      | BinOpExp(exp1,oper,exp2,_)=>
	Exp2Str exp1 ^ BinOp2Str oper ^ Exp2Str exp2
      | LogicOpExp(exp1,oper,exp2,_)=>
	Exp2Str exp1 ^ LogicOp2Str oper ^ Exp2Str exp2
      | RelOpExp(exp1,oper,exp2,_)=>
	Exp2Str exp1 ^ RelOp2Str oper ^ Exp2Str exp2
      | FunCall(id,elist,_)=>
	let val elist_str=sepBy (List.map Exp2Str elist) ","
	in 
	    Id2Str id ^ "(" ^ elist_str ^")"
	end
      | Paren(exp,_)=>
	"(" ^ Exp2Str exp ^")"
      | LvalExp(lval,_) =>
	Lval2Str lval 

and Lval2Str(lval:Lval):string =
    case lval of 
	Ident(id,_)=>
	Id2Str id 
      | Dot(lval',field,_)=>
	"("^Lval2Str lval' ^"."^field^")"
      | Star(lval',_)=>
	"*("^Lval2Str lval' ^")"
      | Pto(lval',field,_)=>
	"("^Lval2Str lval'^ "->"^field^")"
      | Index(l,e,_)=>
	"("^Lval2Str l^"["^Exp2Str e^"])"

and UniOp2Str oper =
    case oper of 
	Neg _ => "-"
      | Not _ => "!"

and BinOp2Str oper =
    case oper of 
	Add _ => "+"
      | Sub _ => "-"
      | Mul _ => "*"
      | Div _ => "/"

and LogicOp2Str oper =
    case oper of 
	And _ => "&&"
      | Or  _ => "||"

and RelOp2Str oper =
    case oper of 
	Eq _ => "=="
      | Ne _ => "!="
      | Gt _ => ">"
      | Ge _ => ">="
      | Lt _ => "<"
      | Le _ => "<="


end

(* ast.sml ends here *)
